100 REM  *MORSE CODER* TI EXTENDED BASIC
110 REM  BY MIKE WILCOX
120 REM  FROM PROGRAMS FOR THE TI HOME COMPUTER
130 REM  COPYRIGHT (C) 1983 BY STEVE DAVIS
140 RANDOMIZE :: CALL CHAR(139,"F0F0F0F00F0F0F0F") :: CALL CLEAR :: CALL SCREEN(16)
150 FOR I=1 TO 32 :: CALL HCHAR(1,I,139) :: NEXT I
160 FOR I=1 TO 24 :: CALL VCHAR(I,32,139) :: NEXT I
170 FOR I=32 TO 1 STEP-1 :: CALL HCHAR(24,I,139) :: NEXT I
180 FOR I=24 TO 1 STEP-1 :: CALL VCHAR(I,1,139) :: NEXT I
190 DISPLAY AT(3,7):"PROGRAMS FOR THE" :: DISPLAY AT(5,7):"TI HOME COMPUTER"
200 DISPLAY AT(7,11):"PRESENTS:" :: DISPLAY AT(10,4):"COMPUTER COURSE IN THE" :: DISPLAY AT(12,3):"INTERNATIONAL MORSE CODE"
210 DISPLAY AT(23,8):"COPYRIGHT 1982" :: DISPLAY AT(18,4):"PRESS ANY KEY TO BEGIN"
220 DEF XX=INT(14*RND+2)
230 CALL KEY(0,K,S) :: CALL SOUND(22,2975,0) :: CALL COLOR(14,XX,1)
240 T=850*INT(RND*2) :: CALL SOUND(22,2125+T,0) :: CALL COLOR(14,1,XX) :: CALL SOUND(-99,2125,0) :: IF S=0 THEN 230
250 OPTION BASE 1 :: DIM U(52) :: CALL SCREEN(8)
260 CALL CLEAR
270 DISPLAY AT(2,8)BEEP :" MENU:" :: DISPLAY AT(4,1):"PRESS-" :: DISPLAY AT(7,1):"1. TO DISPLAY CODE TABLES"
280 DISPLAY AT(9,1):"2. TO PRINT CODE TABLES" :: DISPLAY AT(11,1):"3. TO CODE MESSAGE" :: DISPLAY AT(13,1):"4. TO DECODE MESSAGES"
290 DISPLAY AT(15,1):"5. TO TEST YOURSELF ON CODE" :: DISPLAY AT(17,1):"6. END PROGRAM"
300 CALL KEY(0,K,S) :: W=RND :: IF S=0 THEN 300
310 IF(K<49)+(K>54)THEN 300
320 CALL CLEAR
330 ON K-48 GOTO 340,350,370,380,390,400
340 PR$="" :: FLAG=0 :: CALL CODE(FLAG,PR$) :: GOTO 260
350 DISPLAY "ENTER PRINTER NAME DEVICE" :: INPUT "NAME:":PR$
360 FLAG=1 :: CALL CODE(FLAG,PR$) :: GOTO 260
370 CALL CODER :: GOTO 260
380 CALL DECODER :: GOTO 260
390 CALL TEST(U()) :: GOTO 260
400 CALL CLEAR :: STOP
410 SUB CODE(FLAG,PR$)
420 CALL CLEAR
430 IF FLAG<>1 THEN 450
440 OPEN #1:PR$,OUTPUT
450 C=1 :: R=1
460 RESTORE 900
470 DISPLAY AT(1,2):"INTERNATIONAL MORSE CODE:"
480 FOR I=1 TO 26
490 READ L$,CODE$
500 R=R+2
510 IF R>15 THEN R=3 :: C=C+7
520 DISPLAY AT(R,C):L$;" ";CODE$
530 NEXT I
540 CALL CHAR(97,RPT$("0",9)&"408102") :: CALL CHAR(98,RPT$("0",10)&"205408") :: CALL CHAR(99,RPT$("0",12)&"6666")
550 R=20 :: C=4
560 DISPLAY AT(18,3):"FOREIGN LANGUAGE LETTERS:"
570 FOR I=1 TO 6
580 READ L$,CODE$
590 DISPLAY AT(R,C):L$;" ";CODE$
600 R=R+3
610 IF R>23 THEN R=20 :: C=C+8
620 NEXT I
630 DISPLAY AT(19,4):"a" :: DISPLAY AT(22,4):"c" :: DISPLAY AT(19,12):"a" :: DISPLAY AT(22,12):"b" :: DISPLAY AT(19,20):"c" :: DISPLAY AT(22,20):"c"
640 IF FLAG<>1 THEN 680
650 FOR I=1 TO 24 :: FOR J=1 TO 32 :: CALL GCHAR(I,J,X) :: CALL HCHAR(I,J,30) :: CALL HCHAR(I,J,X)
660 P$=P$&CHR$(X) :: NEXT J :: PRINT #1:P$ :: P$="" :: NEXT I
670 GOTO 690
680 CALL KEY(0,K,S) :: IF S=0 THEN 680
690 CALL CLEAR
700 DISPLAY AT(1,2):"INTERNATIONAL MORSE CODE:"
710 DISPLAY AT(3,1):"PUNCTUATION:"
720 R=5 :: C=1
730 FOR I=1 TO 10
740 READ L$,CODE$
750 DISPLAY AT(R,C):L$ :: DISPLAY AT(R,C+14):CODE$
760 R=R+2
770 NEXT I
780 DISPLAY AT(3,21):"NUMBERS:"
790 R=5 :: C=22
800 FOR I=1 TO 10
810 READ L$,CODE$
820 DISPLAY AT(R,C):L$;" ";CODE$
830 R=R+2
840 NEXT I
850 IF FLAG<>1 THEN 890
860 FOR I=1 TO 24 STEP 2 :: FOR J=1 TO 32 :: CALL GCHAR(I,J,X) :: CALL HCHAR(I,J,30) :: CALL HCHAR(I,J,X)
870 P$=P$&CHR$(X) :: NEXT J :: PRINT #1:P$ :: P$="" :: NEXT I :: CLOSE #1
880 FLAG=0 :: SUBEXIT
890 CALL KEY(0,K,S) :: IF S=0 THEN 890
900 DATA A,._,B,_...,C,_._.,D,..,E,.,F,...,G,__.,H,....,I,..,J,.___,K,_._,L,.-...,M,__,N,_.,O,___
910 DATA P,.__.,Q,__._,R,._.,S,...,T,_,U,.._,V,..._,W,.__,X,_.._,Y,_.__,Z,__..
920 DATA A,.__._,A,._._,E,.._..,N,__.__,O,___.,U,..__
930 DATA ", COMMA",__..__,. PERIOD,._._._,? QUESTION,..__..,; SEMI-COLON,_._._.,: COLON,___...
940 DATA ' APOSTROPHE,.____.,- HYPHEN,_...._,/ SLASH,_.._.,()PARENTHESIS,_.__._,_ UNDERLINE,..__._
950 DATA 1,.____,2,..___,3,...__,4,...._,5,.....,6,_....,7,__...,8,___..,9,____.,0,_____,
960 SUBEND
970 SUB CODER
980 DISPLAY AT(10,1)BEEP ERASE ALL :"WOULD YOU LIKE YOUR CODED": :"MESSAGES PRINTED-OUT (Y/N)?"
990 CALL KEY(3,K,S) :: IF(K<>89)*(K<>78)THEN 990
1000 IF K=78 THEN FLAG=0 ELSE FLAG=1
1010 IF FLAG=0 THEN 1040
1020 DISPLAY "ENTER PRINTER NAME DEVICE" :: INPUT "NAME:":PR$
1030 OPEN #3:PR$,OUTPUT
1040 DISPLAY AT(10,1)BEEP ERASE ALL :"WOULD YOU LIKE YOUR CODED": :"MESSAGE SOUNDED-OUT (Y/N)?"
1050 CALL KEY(3,K,S) :: IF K<>78 AND K<>89 THEN 1050
1060 IF K=89 THEN FLAG2=1 ELSE FLAG2=0
1070 ROW=2 :: COL=1
1080 DISPLAY AT(2,1)ERASE ALL :"YOUR ARE IN THE CODING MODE "
1090 DISPLAY AT(10,3):"TO RETURN TO THE MENU ": :" TYPE AND ENTER ""MENU"""
1100 DISPLAY AT(16,3):"PRESS ANY KEY TO BEGIN." :: CALL KEY(0,K,S) :: IF S=0 THEN 1100
1110 DISPLAY AT(10,10)ERASE ALL :"CODER:" :: DISPLAY AT(12,1)BEEP :"ENTER YOUR MESSAGE TO CODE:": :"(TYPE AND ENTER ""MENU"" TO": :"RETURN.)"
1120 LINPUT MSG$
1130 IF MSG$="MENU" THEN 1430
1140 M$(1)=SEG$(MSG$,1,60) :: M$(2)=SEG$(MSG$,61,120) :: M$(3)=SEG$(MSG$,121,180) :: M$(4)=SEG$(MSG$,181,240) :: M$(5)=SEG$(MSG$,241,300)
1150 CALL CLEAR :: DISPLAY AT(1,3):"TRANSLATING IN PROGRESS"
1160 FOR I=1 TO 5
1170 FOR J=1 TO LEN(M$(I))
1180 RESTORE 900
1190 A$=SEG$(M$(I),J,1) :: IF A$=" " THEN CODE$=" " :: GOTO 1250
1200 FOR X=1 TO 52
1210 READ L$,CODE$
1220 IF A$=SEG$(L$,1,1)THEN 1250
1230 NEXT X
1240 IF A$<>L$ THEN CODE$="#"
1250 CMSG$=CMSG$&CODE$&" "
1260 FOR Z=1 TO LEN(CMSG$)
1270 COL=COL+1 :: IF COL<=31 THEN 1280 ELSE ROW=ROW+2 :: COL=2
1280 IF ROW>22 THEN ROW=3
1290 CALL HCHAR(ROW,COL,ASC(SEG$(CMSG$,Z,1)))
1300 NEXT Z
1310 CMSG$=""
1320 NEXT J
1330 NEXT I
1340 DISPLAY AT(1,1):" " :: DISPLAY AT(24,4):"TRANSLATION COMPLETED"
1350 IF FLAG=0 THEN 1410
1360 P$="" :: FOR X=2 TO 24 STEP 2 :: FOR Z=1 TO 32 :: CALL GCHAR(X,Z,M)
1370 P$=P$&CHR$(M)
1380 NEXT Z :: IF P$=RPT$(" ",32)THEN 1400
1390 PRINT #3:P$ :: P$="" :: NEXT X
1400 REM  PRINTING COMPLETED
1410 IF FLAG2=1 THEN CALL SOUNDER(2,2)
1420 CALL KEY(0,K,S) :: IF S=0 THEN 1420 ELSE ROW=2 :: COL=1 :: GOTO 1110
1430 IF FLAG=0 THEN 1450
1440 CLOSE #3
1450 FLAG=0 :: PR$="" :: SUBEND
1460 SUB DECODER :: MSG$=""
1470 DISPLAY AT(10,1)BEEP ERASE ALL :"WOULD YOU LIKE THE DECODED": :"MESSAGES PRINTED-OUT (Y/N)?"
1480 CALL KEY(3,K,S) :: IF(K<>78)*(K<>89)THEN 1480
1490 IF K=78 THEN FLAG=0 ELSE FLAG=1
1500 IF FLAG=0 THEN 1530
1510 DISPLAY "ENTER PRINTER NAME DEVICE" :: INPUT "NAME:":PR$
1520 OPEN #4:PR$,OUTPUT
1530 DISPLAY AT(10,1)BEEP ERASE ALL :"WOULD YOU LIKE THE CODED": :"MESSAGE SOUNDED-OUT (Y/N)?"
1540 CALL KEY(3,K,S) :: IF K<>78 AND K<>89 THEN 1540
1550 IF K=89 THEN FLAG2=1 ELSE FLAG2=0
1560 DISPLAY AT(2,1)ERASE ALL :"YOU ARE IN THE DECODING MODE" :: DISPLAY AT(5,1):"PRESS ENTER FOR TRANSLATION"
1570 DISPLAY AT(7,6):"""M"" TO RETURN TO MENU": :"FOR YOUR CONVENIENCE YOU": :"MAY USE A COMMA "","" TO PRINT"
1580 DISPLAY AT(13,1):"A DASH "" "" (OR USE FCTN U)"
1590 DISPLAY AT(15,1):"YOU MUST LEAVE ONE SPACE": :"BETWEEN EACH LETTER, AND TWO": :"SPACES BETWEEN EACH WORD."
1600 DISPLAY AT(22,3):"PRESS ANY KEY TO BEGIN"
1610 CALL KEY(0,K,S) :: IF S=0 THEN 1610
1620 DISPLAY AT(4,10)BEEP ERASE ALL :"DECODER:" :: DISPLAY AT(6,1):"PRESS ENTER T0 TRANSLATE": :"PRESS M TO RETURN PRESS C TO CORRECT"
1630 DISPLAY AT(12,1):"ENTER YOUR MESSAGE:"
1640 CALL KEY(3,K,S) :: IF(K<>13)*(K<>32)*(K<>44)*(K<>46)*(K<>67)*(K<>77)*(K<>95)THEN 1640
1650 IF K=67 AND MSG$="" THEN 1710 ELSE IF K=67 THEN MSG$=SEG$(MSG$,1,LEN(MSG$)-1) :: GOTO 1710
1660 IF K=77 THEN 2010
1670 IF K=44 THEN K=95
1680 IF K=32 THEN CALL SOUND(111,1000,5,2000,4,3000,3)
1690 IF K=13 THEN 1730
1700 MSG$=MSG$&CHR$(K)
1710 DISPLAY AT(14,1):MSG$
1720 GOTO 1640
1730 IF FLAG2=1 THEN CALL SOUNDER(14,1)
1740 CALL CLEAR :: ROW=2 :: COL=2 :: T$="" :: CMSG$=""
1750 DISPLAY AT(1,3):"TRANSLATING IN PROGRESS"
1760 S=POS(MSG$," ",1) :: IF S=1 THEN T$=" " :: GOTO I860
1770 IF S=0 THEN A$=MSG$ :: GOTO 1790
1780 A$=SEG$(MSG$,1,S-1)
1790 RESTORE 900
1800 FOR I=1 TO 52
1810 READ L$,CODE$
1820 IF A$=CODE$ THEN 1850
1830 NEXT I
1840 T$="#" :: GOTO 1860
1850 T$=SEG$(L$,1,1)
1860 FOR Z=1 TO LEN(T$)
1870 COL=COL+1
1880 IF COL<=31 THEN 1890 ELSE ROW=ROW+2 :: COL=2
1890 CALL HCHAR(ROW,COL,ASC(SEG$(T$,Z,1)))
1900 IF S=0 THEN 1930
1910 NEXT Z
1920 MSG$=SEG$(MSG$,S+1,LEN(MSG$)) :: GOTO 1760
1930 DISPLAY AT(1,1):" " :: DISPLAY AT(24,3)BEEP :"TRANSLATION COMPLETED"
1940 IF FLAG=0 THEN 2000
1950 P$="" :: FOR X=2 TO 24 STEP 2 :: FOR Z=1 TO 32 :: CALL GCHAR(X,Z,M)
1960 P$=P$&CHR$(M)
1970 NEXT Z :: IF P$=RPT$(" ",32)THEN 1990
1980 PRINT #4:P$ :: P$="" :: NEXT X
1990 REM  PRINTING COMPLETED
2000 CALL KEY(0,K,S) :: IF S=0 THEN 2000 ELSE MS6$="" :: GOTO 1620
2010 IF FLAG=0 THEN 2030
2020 CLOSE #4
2030 SUBEND
2040 SUB TEST(U())
2050 SCORE,RIGHT=0 :: FOR I=1 TO 52 :: U(I)=0 :: NEXT I
2060 DISPLAY AT(1,5)ERASE ALL :"SELF-TEST MODE:"
2070 DISPLAY AT(3,1):"THE COMPUTER WILL RANDOMLY": :"SELECT 10 LETTERS, NUMBERS,": :"OR PUNCTUATION SYMBOLS [NO"
2080 DISPLAY AT(9,1):"FOREIGN LANGUAGE LETTERS]": :"AND YOU WILL NEED TO PROVIDEH": :"EITHER THE CORRECT CODE OR"
2090 DISPLAY AT(15,1):"THE LETTER, NUMBER OR SYMBOL": :"THAT IS BEING DEFINED."
2100 DISPLAY AT(19,1):"YOU WILL RECIEVE A SCORE AT": :"THE END OF THIS TEST.": :" PRESS ANY KEY TO START"
2110 CALL KEY(0,K,S) :: IF S=0 THEN 2110
2120 DISPLAY AT(10,9)ERASE ALL :"TEST SET-UP" :: DISPLAY AT(12,9):"IN PROGRESS..." :: DISPLAY AT(14,7):"PLEASE STAND BY..."
2130 REM  SET-UP TEST
2140 FOR I=1 TO 10
2150 N=INT(52*RND+1)
2160 IF(N>26)*(N<33)THEN 2150
2170 IF U(N)=1 THEN 2150
2180 U(N)=1
2190 RESTORE 900
2200 FOR RD=1 TO N
2210 READ L$,CODE$
2220 NEXT RD
2230 IF RND>.45 THEN Q$(I)=CODE$ :: A$(I)=SEG$(L$,1,1)ELSE Q$(I)=SEG$(L$,1,1) :: A$(I)=CODE$
2240 NEXT I
2250 CALL CLEAR
2260 FOR I=1 TO 10
2270 IF SEG$(Q$(I),1,1)=" " AND A$(I)="..__._" OR SEG$(Q$(I),1,1)="." AND A$(I)="._._._" THEN DISPLAY AT(I*2-1,1):" CODE:" :: GOTO 2290
2280 IF SEG$(Q$(I),1,1)="." OR SEG$(Q$(I),1,1)="_" THEN DISPLAY AT(I*2-1,1):"DECODE:" ELSE DISPLAY AT(I*2-1,1):" CODE:"
2290 DISPLAY AT(I*2-1,9):Q$(I)
2300 ACCEPT AT(I*2-1,16)BEEP :AN$
2310 IF AN$<>A$(I)THEN CALL SOUND(110,220,2,330,3) :: DISPLAY AT(I*2,1):"THE RIGHT ANSWER IS ";A$(I)
2320 IF AN$=A$(I)THEN DISPLAY AT(I*2,1):"YOU ARE CORRECT!" :: RIGHT=RIGHT+1
2330 NEXT I
2340 SCORE=RIGHT*10 :: DISPLAY AT(22,4):"YOUR SCORE IS ";STR$(SCORE);"%"
2350 DISPLAY AT(24,2):"PRESS ANY KEY TO CONTINUE"
2360 CALL KEY(0,K,S) :: IF S=0 THEN 2360
2370 SUBEND
2380 SUB SOUNDER(M,N)
2382 ADIT=80
2390 FOR I=1 TO 300 :: NEXT I
2400 DISPLAY AT(1,4):"NOW SOUNDING-OUT CODE" :: DISPLAY AT(24,1):""
2410 FOR I=M TO 24 STEP N :: FOR J=2 TO 31 :: CALL GCHAR(I,J,C)
2420 IF C=32 THEN CALL SOUND(250,42000,30) :: X=X+1
2430 IF X=5 THEN 2470
2440 IF C=46 THEN CALL SOUND(ADIT,2125,0) :: CALL SOUND(ADIT*3,42000,30) :: X=0
2450 IF C=95 THEN CALL SOUND(ADIT*3,2125,1) :: CALL SOUND(ADIT*3,42000,30) :: X=0
2460 NEXT J :: NEXT I
2470 DISPLAY AT(1,1):"" :: DISPLAY AT(24,4):"SOUND-OFF COMPLETED" :: X=0
2480 SUBEND
2490 END
